home *** CD-ROM | disk | FTP | other *** search
/ The PC-SIG Library 10 / The PC-Sig Library - Shareware for the IBM PC and Compatibles (PC-SIG)(Tenth Edition Disks 1-2804)(1991).iso / PC_SIGCD / 20 / 5 / DISK2058.ZIP / UNFAST.EXE / DEMO.F < prev    next >
Text File  |  1980-01-01  |  6KB  |  300 lines
  1. ;===========================================================================;
  2. ;                                        ;
  3. ;             PETER CAMPBELL SOFTWARE                ;
  4. ;                                        ;
  5. ;===========================================================================;
  6. ; A demonstration program for FAST, it's about time I did something to show ;
  7. ; some of the things that FAST is capable of.                    ;
  8. ;===========================================================================;
  9.  
  10. #window memory 10000
  11. #short
  12. store ? 16
  13. unsigned m
  14.  
  15. proc clear_screen
  16.     {
  17.     if mono then screen 7
  18.     if not mono and (screen<>3) then screen 3
  19.     cls
  20.     cursor 23,0
  21.     }
  22.  
  23. on error
  24.     {
  25.     clear_screen
  26.     cursor 0,0
  27.     print dos "DEMO has aborted, error encountered: ";
  28.     error msg "\dos.err"
  29.     print dos "!"
  30.     stop
  31.     }
  32.  
  33. proc abort
  34.     {
  35.     clear_screen
  36.     locate 0,0
  37.     print "DEMO ended!"
  38.     print
  39.     print "How about looking at some FAST source code?"
  40.     print
  41.     print "To edit (or simply view) the demo source code then type"
  42.     print "WT DEMO"
  43.     print
  44.     print "WT is written in FAST and will show you a practical example of FAST"
  45.     print "while simultaneously showing you the DEMO.F source file"
  46.     print "(WT is a text editor written in FAST)."
  47.  
  48.     loctocur
  49.     stop
  50.     }
  51.  
  52. proc push_any_key
  53.     {
  54.     open window wpush
  55.     wait for keypressed
  56.     if scan=1 then abort
  57.     close window
  58.     }
  59.  
  60. fseg=allocate 4096
  61.  
  62. ;== INTRO ==================================================================
  63.  
  64. clear_screen
  65. open window wpc_fast
  66.  
  67. ;== FAST ===================================================================
  68.  
  69. m=afast
  70. for y=15 to 21
  71.     locate y,0
  72.     m=printm m,80
  73. next y
  74.  
  75. delay=0
  76. while delay<500
  77.     {
  78.     repeat 580-(delay)
  79.     {
  80.     l=15*160
  81.     repeat 7
  82.         {
  83.         c=video[l]
  84.         move 79 from video|l+2 to video|l
  85.         video[l+158]=c
  86.         l+=160
  87.         }
  88.     for d=0 to delay:next d
  89.     }
  90.     delay+=100
  91.     }
  92.  
  93. push_any_key
  94.  
  95. repeat 12
  96.     {
  97.     scroll down 0,15,79,24,1
  98.     repeat 12000 {}
  99.     }
  100.  
  101. ;== WINDOW SPLAT ===========================================================
  102.  
  103. c=100
  104. while c
  105.     {
  106.     x=rnd mod 70
  107.     y=rnd mod 20
  108.     pokeb wrnd+2,x:pokeb wrnd+4,x+9
  109.     pokeb wrnd+3,y:pokeb wrnd+5,y+5
  110.     pokeb wrnd+6,(rnd mod 3)+5
  111.     open window wrnd
  112.     c--
  113.     if c>=18 then
  114.     {
  115.     repeat 6000 {}
  116.     close window
  117.     }
  118.     }
  119.  
  120. repeat 50000 {}
  121.  
  122. repeat 10
  123.     {
  124.     open window wall
  125.     repeat 20000 {}
  126.     close window
  127.     }
  128.  
  129. repeat 60
  130.     {
  131.     open window wall
  132.     close window
  133.     }
  134.  
  135. push_any_key
  136.  
  137. ;== SCROLL SCREEN ==========================================================
  138.  
  139. repeat 60
  140.     {
  141.     r=rnd mod 5
  142.     #long
  143.     if r=0 then
  144.     {
  145.     repeat 12
  146.         {
  147.         move 2000 from video|0 to video|320
  148.         move 160 from video|4000 to video|0
  149.         }
  150.     move 2000 from video|0 to video|160
  151.     move 80 from video|4000 to video|0
  152.     }
  153.     if r=1 then
  154.     {
  155.     repeat 12
  156.         {
  157.         move 160 from video|0 to video|4000
  158.         move 2000 from video|320 to video|0
  159.         move 160 from video|4000 to video|4000-320
  160.         }
  161.     move 80 from video|0 to video|4000
  162.     move 2000 from video|160 to video|0
  163.     move 80 from video|4000 to video|4000-160
  164.     }
  165.     if r=2 then
  166.     {
  167.     repeat 10
  168.         {
  169.         for y2=0 to 3840 step 160
  170.         move 8 from video|y2+144 to store
  171.         move 72 from video|y2 to video|y2+16
  172.         move 8 from store to video|y2
  173.         next y2
  174.         }
  175.     }
  176.     if r=3 then
  177.     {
  178.     repeat 10
  179.         {
  180.         for y3=0 to 3840 step 160
  181.         move 8 from video|y3 to store
  182.         move 72 from video|y3+16 to video|y3
  183.         move 8 from store to video|y3+144
  184.         next y3
  185.         }
  186.     }
  187.     if r=4 then
  188.     {
  189.     repeat 10
  190.         {
  191.         for y4=0 to 3840 step 320
  192.         move 8 from video|y4 to store
  193.         move 72 from video|y4+16 to video|y4
  194.         move 8 from store to video|y4+144
  195.  
  196.         y4+=160
  197.         move 8 from video|y4+144 to store
  198.         move 72 from video|y4 to video|y4+16
  199.         move 8 from store to video|y4
  200.         y4-=160
  201.         next y4
  202.         }
  203.     }
  204.     #short
  205.     }
  206.  
  207. repeat 5 repeat 20000 {}
  208. repeat 18 close window
  209. push_any_key
  210.  
  211. ;== HEX, DECIMAL DUMP ======================================================
  212.  
  213. proc dump(hd)
  214.     {
  215.     c=10000:y=11
  216.     while c<=16000
  217.     {
  218.     locate y,0
  219.     if hd=0 then repeat 16 printh c;" ";:c++
  220.     else
  221.         {
  222.         n=locpos+148
  223.         while locpos<n
  224.         {
  225.         print c;" ";:c++
  226.         }
  227.         }
  228.     y++:if y>24 then scroll 0,11,79,24,1:y=24
  229.     }
  230.     }
  231.  
  232. dump(0)
  233. dump(1)
  234. push_any_key
  235.  
  236. ;===========================================================================
  237.  
  238. fill 32768 from fseg|0 with 1a1ah
  239. load "wt.f",fseg|0
  240. m=0
  241. close window
  242.  
  243. proc display_page
  244.     {
  245.     for y=0 to 24
  246.     locate y,0
  247.     m=printm fseg|m,80
  248.     next y
  249.     }
  250.  
  251. display_page
  252. repeat 4 repeat 50000 {}
  253. while fseg[m]b<>1ah display_page
  254.  
  255. fill 80*7 from video|2080 with 7820h
  256. colour 120
  257. locate 16,10:print "THAT WAS A 40K SOURCE FILE (WT.F) PAGE DOWN ON YOUR SCREEN"
  258. colour 7
  259. push_any_key
  260.  
  261. ;===========================================================================
  262.  
  263. abort
  264.  
  265. ;== DEMO DATA ==============================================================
  266.  
  267. wpc_fast:
  268. datab 0,0,1,1,78,10,120
  269. datab 22,27,2,'PETER CAMPBELL SOFTWARE'
  270. datab 22,11,3,'FAST: The new PC language to make your computer perform!'
  271. datab 22,11,5,'This demonstration shows FAST at work on the screen.'
  272. datab 22,4,6,'Programs look fast if what appears on the screen is quick and smooth.'
  273. datab 22,3,7,'FAST is fastest on screen and on internal IF-THEN-ELSE and numbers etc.'
  274. datab 26
  275.  
  276. afast:
  277. fname '████████    ██████     ███████    ███████'
  278. fname '█      █     █   █           █'
  279. fname '█      █     █   █           █'
  280. fname '█████      ████████    ██████       █'
  281. fname '█      █     █        █       █'
  282. fname '█      █     █        █       █'
  283. fname '█      █     █   ███████       █'
  284.  
  285. wpush:
  286. datab 0,0,62,19,79,24,7
  287. datab 22,2,2,'Push any key...'
  288. datab 22,3,3,'(esc aborts.)'
  289. datab 26
  290.  
  291. wrnd:
  292. datab 0,0,0,0,0,0,15
  293. datab 22,2,2,'Window.'
  294. datab 26
  295.  
  296. wall:
  297. datab 0,0,0,0,79,24,15
  298. datab 22,31,12,'Full Screen Window'
  299. datab 26
  300.